unit ProcessDelphi;

{*
This is TProcess compatibility layer for Delphi
May not be fully compatible yet, this unit provide only very basic compatibility to TProcess in FPC
}

interface

uses SysUtils, Windows, ShellApi, Forms, Classes;

type
  TProcessOptions = (poNone, poWaitOnExit, poUsePipes); //* Process options

type
  TProcess = class //* Delphi compatibility class for executing processes
    CommandLine : string;             //* prikaz pre prikazovy riadok
    Options : set of TProcessOptions; //* how to run process
    ExitStatus : integer;             //* return value of a child process
    Output : TStream;                 //* output of executed program
    constructor Create(APointer : pointer); virtual;
    procedure Execute; virtual;
  end;

implementation

function run_no_wait(fname,dir,params : string; ShowCmd : integer) : boolean;
{*
Run other application but do not wait for it's end
Return TRUE if application was executed successfully
}
var SEInfo : TShellExecuteInfo;
    ok : boolean;
begin
  { nastavenie premennych }
  FillChar(SEInfo, SizeOf(SEInfo), 0);
  with SEInfo do
    begin
      cbSize := SizeOf(TShellExecuteInfo);
      fMask := SEE_MASK_NOCLOSEPROCESS;
      Wnd := Application.Handle;
      nShow := showCmd;
      lpFile:=pchar(fname);
      lpDirectory:=pchar(dir);
      lpParameters:=pchar(params);
    end;
  { spustenie programu }
  ok:=ShellExecuteEx(@SEInfo);
  { navrat }
  run_no_wait:=ok;
end;

function run_and_wait(fname,dir,params : string; ShowCmd : integer) : boolean;
{*
Run other application and wait for it's end
Return TRUE if application was executed successfully
}
var SEInfo : TShellExecuteInfo;
    ExCode : DWORD;
    ok : boolean;
begin
  { nastavenie premennych }
  FillChar(SEInfo, SizeOf(SEInfo), 0);
  with SEInfo do
    begin
      cbSize := SizeOf(TShellExecuteInfo);
      fMask := SEE_MASK_NOCLOSEPROCESS;
      Wnd := Application.Handle;
{      nShow := SW_SHOWNORMAL;}
      nShow := showCmd;
      lpFile:=pchar(fname);
      lpDirectory:=pchar(dir);
      lpParameters:=pchar(params);
    end;
  { spustenie programu }
  ok:=ShellExecuteEx(@SEInfo);
  { cakanie na ukoncenie spusteneho programu }
  if ok then
    repeat
      Application.ProcessMessages;
      GetExitCodeProcess(SEInfo.hProcess, ExCode);
      sleep(10);
    until (ExCode <> STILL_ACTIVE) or Application.Terminated;
  { navrat }
  run_and_wait:=ok;
end;

{ TMyProcess }

constructor TProcess.Create(APointer: pointer);
begin
  inherited Create;
end;

procedure TProcess.Execute;
{*
Run process
}
var s1,s2 : ansistring;
    p : integer;
begin
  //FIXME: will fail if command is in quotes and contain space!
  p := pos(' ',CommandLine);
  if p>0 then
  begin
    s1 := copy(CommandLine,1,p-1);
    s2 := copy(CommandLine,p+1,maxint);
  end else
  begin
    s1 := CommandLine;
    s2 := '';
  end;
  if run_and_wait(s1,'',s2,SW_SHOW) then //FIXME: I doubt run_and_wait really return false on fail!
    ExitStatus := 0
  else
    ExitStatus := 1;
end;

end.
